home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
acad
/
autolisp
/
door
/
door.lsp
Wrap
Text File
|
1989-09-24
|
8KB
|
167 lines
;;; -*- Mode: LISP -*- Syntax: AutoLISP (C) Benjamin Olasov 1988
;;; Two pick door programs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File: DOOR.LSP Copyright (C) Benjamin Olasov 1988 All Rights Reserved ;;;
;;; Inquiries: ;;;
;;; ;;;
;;; Benjamin Olasov ;;;
;;; Graphic Systems, Inc.: ;;;
;;; ;;;
;;; New York, NY: PH (212) 725-4617 ;;;
;;; Cambridge, MA: PH (617) 492-1148 ;;;
;;; MCI-Mail: GSI-NY 344-4003 ;;;
;;; Arpanet: olasov@cs.columbia.edu ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is provided 'as is' without warranty of any kind, either
;; expressed or implied, including, but not limited to the implied warranties of
;; merchantability and fitness for a particular purpose. The entire risk as to
;; the quality and performance of the program is with the user. Should the
;; program prove defective, the user assumes the entire cost of all necessary
;; servicing, repair or correction.
;; AutoLisp and AutoCad are registered trademarks of AutoDesk, Inc.
(gc)
(vmon)
(princ "\nPlease wait- loading.")
(DEFUN C:DOOR (/ HP1 HP2 DWIDTH SP1 SP2 C-LAY BOX LINE1 LINE2)
(SETQ OS (GETVAR "OSMODE")
CMD (GETVAR "CMDECHO")
COORDS (GETVAR "COORDS")
PICK (GETVAR "PICKBOX"))
(SETVAR "CMDECHO" 0)
(SETVAR "COORDS" 2)
(SETVAR "OSMODE" 256)
(SETQ HP1 (GETPOINT "\nHinge pt: ")
HP1 (OSNAP HP1 "NEAR")
SP1 (GETPOINT HP1 "\nSwing pt: ")
SP1 (OSNAP SP1 "NEAR")
DWIDTH (DISTANCE HP1 SP1)
C-LAY (GETVAR "CLAYER")
BOX (SSGET "C" (LIST (- (CAR HP1) 12.0) (- (CADR HP1) 12.0))
(LIST (+ (CAR HP1) 12.0) (+ (CADR HP1) 12.0))))
(IF (AND BOX (SETQ LINE1 (ENTGET (SSNAME (SSGET HP1) 0))))
(PROGN (SSDEL (CDR (ASSOC -1 LINE1)) BOX) ;; remove first line from box
(FOREACH ENT (SS2ELIST BOX)
(IF (OR (/= (CDR (ASSOC 8 ENT))
(CDR (ASSOC 8 LINE1)))
(/= (CDR (ASSOC 0 ENT)) "LINE")
(NOT (PARALLEL ENT LINE1)))
(SSDEL (CDR (ASSOC -1 ENT)) BOX)))
(SETVAR "OSMODE" 0)
(IF (> (SSLENGTH BOX) 0) ;; look in the box
(PROGN (SETQ LINE2 (ENTGET (SSNAME BOX 0))
HP2 (INTERS (CDR (ASSOC 10 LINE2))
(CDR (ASSOC 11 LINE2))
HP1
(POLAR HP1 (IF (> PI (ANGLE HP1 SP1))
(- (ANGLE HP1 SP1) (/ PI 2.0))
(+ (ANGLE HP1 SP1) (/ PI 2.0)))
(DISTANCE HP1 SP1)) nil))
(COMMAND "LAYER" "S" (CDR (ASSOC 8 LINE1)) "")
(SETQ SP2 (POLAR HP2 (ANGLE HP1 SP1) DWIDTH)
P5 (POLAR HP1 (ANGLE HP2 HP1) DWIDTH))
(COMMAND "BREAK" HP1 SP1)
(COMMAND "BREAK" HP2 SP2)
(COMMAND "LINE" HP1 HP2 "")
(COMMAND "LINE" SP1 SP2 "")
(COMMAND "LAYER" "M" "DOOR" "C" "5" "" "")
(COMMAND "LINE" HP1 P5 "")
(COMMAND "ARC" SP1 "E" P5 "D" (ATOF (ANGTOS (ANGLE HP2 HP1) 0 4)))
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OS)
(SETVAR "PICKBOX" PICK)
(COMMAND "LAYER" "S" C-LAY "")))))
(PRINC))
(princ ".")
(DEFUN C:DDOOR (/ HP1 HP2 DWIDTH HHP1 HHP2 C-LAY BOX LINE1 LINE2)
(SETQ OS (GETVAR "OSMODE")
CMD (GETVAR "CMDECHO")
COORDS (GETVAR "COORDS")
PICK (GETVAR "PICKBOX"))
(SETVAR "CMDECHO" 0)
(SETVAR "COORDS" 2)
(SETVAR "OSMODE" 256)
(SETQ HP1 (GETPOINT "\nHinge pt: ")
HP1 (OSNAP HP1 "NEAR")
HHP1 (GETPOINT HP1 "\nOther hinge pt: ")
HHP1 (OSNAP HHP1 "NEAR")
DWIDTH (DISTANCE HP1 HHP1)
HFWIDTH (/ DWIDTH 2.0)
SP (POLAR HP1 (ANGLE HP1 HHP1) HFWIDTH)
C-LAY (GETVAR "CLAYER")
BOX (SSGET "C" (LIST (- (CAR HP1) 12.0) (- (CADR HP1) 12.0))
(LIST (+ (CAR HP1) 12.0) (+ (CADR HP1) 12.0))))
(IF (AND BOX (SETQ LINE1 (ENTGET (SSNAME (SSGET HP1) 0))))
(PROGN (SSDEL (CDR (ASSOC -1 LINE1)) BOX) ;; remove first line from box
(FOREACH ENT (SS2ELIST BOX)
(IF (OR (/= (CDR (ASSOC 8 ENT))
(CDR (ASSOC 8 LINE1)))
(/= (CDR (ASSOC 0 ENT)) "LINE")
(NOT (PARALLEL ENT LINE1)))
(SSDEL (CDR (ASSOC -1 ENT)) BOX)))
(SETVAR "OSMODE" 0)
(SETVAR "PICKBOX" 1)
(IF (> (SSLENGTH BOX) 0) ;; look in the box
(PROGN (SETQ LINE2 (ENTGET (SSNAME BOX 0))
HP2 (INTERS (CDR (ASSOC 10 LINE2))
(CDR (ASSOC 11 LINE2))
HP1
(POLAR HP1 (IF (> PI (ANGLE HP1 HHP1))
(- (ANGLE HP1 HHP1) (/ PI 2.0))
(+ (ANGLE HP1 HHP1) (/ PI 2.0)))
(DISTANCE HP1 HHP1)) nil))
(COMMAND "LAYER" "S" (CDR (ASSOC 8 LINE1)) "")
(SETQ HHP2 (POLAR HP2 (ANGLE HP1 HHP1) DWIDTH)
P5 (POLAR HP1 (ANGLE HP2 HP1) HFWIDTH)
P6 (POLAR HHP1 (ANGLE HHP2 HHP1) HFWIDTH))
(COMMAND "BREAK" HP1 HHP1)
(COMMAND "BREAK" HP2 HHP2)
(COMMAND "LINE" HP1 HP2 "")
(COMMAND "LINE" HHP1 HHP2 "")
(COMMAND "LAYER" "M" "DOOR" "C" "5" "" "")
(COMMAND "LINE" HP1 P5 "")
(COMMAND "ARC" SP "E" P5 "D" (ATOF (ANGTOS (ANGLE HP2 HP1) 0 4)))
(COMMAND "LINE" HHP1 P6 "")
(COMMAND "ARC" SP "E" P6 "D" (ATOF (ANGTOS (ANGLE HP2 HP1) 0 4)))
(COMMAND "LAYER" "S" C-LAY "")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OS)
(SETVAR "PICKBOX" PICK)))))
(PRINC))
(princ ".")
;; convert a selection set to a list of entity lists
(DEFUN SS2ELIST (SS / ENTLIST COUNTER)
(SETQ COUNTER 0)
(REPEAT (SSLENGTH SS)
(PROGN (SETQ ENTLIST (CONS (ENTGET (SSNAME SS COUNTER)) ENTLIST))
(SETQ COUNTER (1+ COUNTER)))) ENTLIST)
(princ ".")
(DEFUN PARALLEL (LINE1 LINE2) ;; Takes 2 e-lists as arguments.
(OR (~= (ANGLE (CDR (ASSOC 10 LINE1)) ;; Allow tolerance for nearly
(CDR (ASSOC 11 LINE1))) ;; parallel lines.
(ANGLE (CDR (ASSOC 10 LINE2))
(CDR (ASSOC 11 LINE2))) (/ PI 90.0)) ;; 2 degrees tol
(~= (ANGLE (CDR (ASSOC 11 LINE1))
(CDR (ASSOC 10 LINE1)))
(ANGLE (CDR (ASSOC 10 LINE2))
(CDR (ASSOC 11 LINE2))) (/ PI 90.0))))
(princ ".")
(DEFUN ~= (ACT_VAL TEST_VAL TOL) ;;fuzzy equality
(AND (<= ACT_VAL (+ TEST_VAL TOL))
(>= ACT_VAL (- TEST_VAL TOL))))
(princ "\nC:DOOR and C:DDOOR loaded. Type DOOR or DDOOR to begin.")
